home *** CD-ROM | disk | FTP | other *** search
- /* Scheme In One Define.
-
- The garbage collector, the name and other parts of this program are
-
- * COPYRIGHT (c) 1989 BY *
- * PARADIGM ASSOCIATES INCORPORATED, CAMBRIDGE, MASSACHUSETTS. *
-
- Conversion to full scheme standard, characters, vectors, ports, complex &
- rational numbers, and other major enhancments by
-
- * Scaglione Ermanno, v. Pirinoli 16 IMPERIA P.M. 18100 ITALY *
-
- Permission to use, copy, modify, distribute and sell this software and its
- documentation for any purpose and without fee is hereby granted, provided
- that the above copyright notice appear in all copies and that both that
- copyright notice and this permission notice appear in supporting
- documentation, and that the name of Paradigm Associates Inc not be used in
- advertising or publicity pertaining to distribution of the software without
- specific, written prior permission.
-
- PARADIGM DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
- ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL
- PARADIGM BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
- ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
- IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
- OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-
- */
-
- #include <stdio.h>
- #include <string.h>
- #include <ctype.h>
- #include <setjmp.h>
- #include <signal.h>
- #include <math.h>
-
- #include "siod.h"
-
-
- void init_subr(name,type,fcn)
- char *name; long type; LISP (*fcn)();
- {setv(cintern(name),subrcons(type,name,fcn));}
-
- void init_subr_fond(void)
- {init_subr("dos-call",tc_subr_1,dos_call);
- init_subr("inspect",tc_subr_1,inspect);
- init_subr("*error*",tc_subr_0,error_han);
- init_subr("cons",tc_subr_2,cons);
- init_subr("car",tc_subr_1,car);
- init_subr("cdr",tc_subr_1,cdr);
- init_subr("set-car!",tc_subr_2,setcar);
- init_subr("set-cdr!",tc_subr_2,setcdr);
- init_subr("list",tc_lsubr,llist);
- init_subr("append",tc_lsubr,append);
- init_subr("reverse",tc_subr_1,reverse);
- init_subr("member",tc_subr_2,member);
- init_subr("delete!",tc_subr_2,delete);
- init_subr("+",tc_lsubr,plus);
- init_subr("-",tc_lsubr,difference);
- init_subr("*",tc_lsubr,ltimes);
- init_subr("/",tc_lsubr,quotient);
- init_subr(">",tc_subr_2,greaterp);
- init_subr("<",tc_subr_2,lessp);
- init_subr("=",tc_subr_2,uguale);
- init_subr("<>",tc_subr_2,diverso);
- init_subr(">=",tc_subr_2,greatereqp);
- init_subr("<=",tc_subr_2,lesseqp);
- init_subr("eq?",tc_subr_2,eq);
- init_subr("equal?",tc_subr_2,equal);
- init_subr("1+",tc_subr_1,add1);
- init_subr("-1+",tc_subr_1,sub1);
- init_subr("min",tc_lsubr,lmin);
- init_subr("max",tc_lsubr,lmax);
- init_subr("gcd",tc_lsubr,gcd);
- init_subr("lcm",tc_lsubr,lcm);
- init_subr("remainder",tc_subr_2,remainder);
- init_subr("modulo",tc_subr_2,modulo);
- init_subr("expt",tc_subr_2,expt);
- init_subr("quotient",tc_subr_2,lquotient);
- init_subr("abs",tc_subr_1,Labs);
- init_subr("floor",tc_subr_1,lfloor);
- init_subr("ceiling",tc_subr_1,ceiling);
- init_subr("round",tc_subr_1,lround);
- init_subr("sqrt",tc_subr_1,lsqrt);
- init_subr("exp",tc_subr_1,lexp);
- init_subr("random",tc_subr_1,random);
- init_subr("randomize",tc_subr_1,randomize);
- init_subr("log",tc_subr_2,llog);
- init_subr("sin",tc_subr_1,lsin);
- init_subr("cos",tc_subr_1,lcos);
- init_subr("tan",tc_subr_1,ltan);
- init_subr("asin",tc_subr_1,lasin);
- init_subr("acos",tc_subr_1,lacos);
- init_subr("atan",tc_subr_2,latan);
- init_subr("make-complex",tc_subr_2,makecomp);
- init_subr("make-rational",tc_subr_2,makerat);
- init_subr("imaginary",tc_subr_1,getimag);
- init_subr("real",tc_subr_1,getreal);
- init_subr("numerator",tc_subr_1,getnumer);
- init_subr("denominator",tc_subr_1,getdenom);
- init_subr("truncate",tc_subr_1,lltruncate);
- init_subr("float",tc_subr_1,ltofloat);
- init_subr("complex",tc_subr_1,ltocomplex);
- init_subr("rational",tc_subr_1,ltorational);
- init_subr("null?",tc_subr_1,nullp);
- init_subr("proc?",tc_subr_1,procp);
- init_subr("environment?",tc_subr_1,envp);
- init_subr("symbol?",tc_subr_1,symbolp);
- init_subr("macro?",tc_subr_1,macrop);
- init_subr("number?",tc_subr_1,numberp);
- init_subr("string?",tc_subr_1,stringp);
- init_subr("char?",tc_subr_1,charp);
- init_subr("float?",tc_subr_1,floatp);
- init_subr("integer?",tc_subr_1,integerp);
- init_subr("rational?",tc_subr_1,rationalp);
- init_subr("complex?",tc_subr_1,complexp);
- init_subr("vector?",tc_subr_1,vectorp);
- init_subr("port?",tc_subr_1,portp);
- init_subr("eof-object?",tc_subr_1,eof_valp);
- init_subr("read",tc_subr_1,lread);
- init_subr("print",tc_subr_2,lprint);
- init_subr("display",tc_subr_2,lprin);
- init_subr("writeln",tc_lsubr,writeln);
- init_subr("load",tc_fsubr,load);
- init_subr("open-port",tc_subr_3,openport);
- init_subr("close-port",tc_subr_1,close_port);
- init_subr("vector-set!",tc_subr_3,vectorset);
- init_subr("vector-ref",tc_subr_2,vectorref);
- init_subr("vector-length",tc_subr_1,vectorlenght);
- init_subr("vector",tc_lsubr,vectorm);
- init_subr("eval",tc_subr_2,lleval);
- init_subr("define",tc_fsubr,leval_define);
- init_subr("set!",tc_fsubr,leval_setq);
- init_subr("macro",tc_fsubr,leval_macro);
- init_subr("lambda",tc_fsubr,leval_lambda);
- init_subr("quote",tc_fsubr,leval_quote);
- init_subr("map",tc_fsubr,leval_map);
- init_subr("begin",tc_msubr,leval_progn);
- init_subr("if",tc_msubr,leval_if);
- init_subr("do",tc_msubr,leval_do);
- init_subr("cond",tc_msubr,leval_cond);
- init_subr("or",tc_msubr,leval_or);
- init_subr("and",tc_msubr,leval_and);
- init_subr("gc",tc_lsubr,user_gc);
- init_subr("freesp",tc_subr_0,freesp);
- init_subr("let",tc_msubr,leval_let);
- init_subr("the-environment",tc_fsubr,leval_tenv);
- init_subr("environment-bindings",tc_subr_1,environment_bindings);
- init_subr("environment-parent",tc_subr_1,environment_parent);
- init_subr("string-ref",tc_subr_2,string_ref);
- init_subr("string-set!",tc_subr_3,string_set);
- init_subr("string-append",tc_lsubr,string_append);
- init_subr("string-length",tc_subr_1,string_lenght);
- init_subr("string-cmp",tc_subr_2,string_cmp);
- init_subr("substring",tc_subr_3,substring);
- init_subr("char-cmp",tc_subr_2,charcmp);
- init_subr("char->integer",tc_subr_1,chartoint);
- init_subr("integer->char",tc_subr_1,inttochar);
- init_subr("error",tc_lsubr,lerr);
- init_subr("quit",tc_subr_0,quit);}
-